Background given in the case description: “The course lasts twelve weeks. Throughout the course, students are assessed in multiple ways, including weekly quizzes, slide exams, and essays. They also take an end of course exam that includes essay, short answer, and multiple-choice components. The final data has the average scores for those assessments. Students are required to take laboratory practical (gross anatomy, histology, pathology and neuroanatomy) exams which are averaged into the final grade. Students also take a National Board of Medical Examiners (NBME) standardized exam in each course. Theoretically, if they do well on these exams, they should do well in the course overall. All of the assessments have been calculated on a 100- point scale.”
1.1 Questions from Learning Objective 4
How should we define not pass/ marginal pass/ pass thresholds and criteria?
How do these thresholds compare to final exam scores?
1.2 Data
There are 92 students. 2 students scored below 70 on the final exam which is grounds for an immediate failing threshold. 3 students scored between a 70 & 80 on the final which could be considered students for further scrutiny.
Code
label(dt$quiz) <-"Quiz score (mean weekly performance)"label(dt$nbme) <-"National Board of Medical Examiners score"label(dt$ga) <-"Gross anatomy (mean score)"label(dt$slide) <-"Slide exams score (mean)"label(dt$part.c) <-"Part C score"label(dt$essay) <-"Essay score (mean)"label(dt$eob.exam) <-"End of Block (course term) exam"label(dt$final) <-"Final score"table1(~quiz + nbme + ga + slide + part.c + essay+ eob.exam + final , data=dt, topclass="Rtable1-zebra",)
Overall (N=92)
Quiz score (mean weekly performance)
Mean (SD)
0.821 (0.0685)
Median [Min, Max]
0.820 [0.660, 1.00]
National Board of Medical Examiners score
Mean (SD)
89.9 (5.45)
Median [Min, Max]
91.0 [74.0, 100]
Gross anatomy (mean score)
Mean (SD)
83.0 (9.89)
Median [Min, Max]
83.9 [49.5, 100]
Slide exams score (mean)
Mean (SD)
82.3 (10.0)
Median [Min, Max]
83.9 [53.1, 100]
Part C score
Mean (SD)
81.1 (8.70)
Median [Min, Max]
81.6 [59.6, 100]
Essay score (mean)
Mean (SD)
86.8 (5.42)
Median [Min, Max]
87.3 [71.3, 95.8]
End of Block (course term) exam
Mean (SD)
84.9 (6.83)
Median [Min, Max]
85.0 [65.0, 99.0]
Final score
Mean (SD)
88.5 (5.63)
Median [Min, Max]
88.5 [68.0, 100]
Code
length(unique(dt$id))
[1] 92
Note: Part C score is “like a catch-all exam if the knowledge can’t be obtained through their lab and essay assessments.”
not included in our data (but included in the student evaluation) is the score for the laboratory practical which “has multiple assessment scores which are captured in the data such as the histology, pathology, etc. - which are not specifically named like that.”
We will disregard for our purposes
1.2.1 Scores based on startifying by passing the final exam at 70% threshold
Below is a pairs plot where students are divided into groups depending on whether they passed or if they scored below 80% which we called “almost fail”. These students deserve more scrutiny - how did they perform on other assessments?
---title: "Case 1 Learning Objective 4"author: "Lisa Levoir and Jeffrey Zhuohui Liang"date: "`r format(Sys.time(), '%B %d, %Y')`"format: html: theme: yeti code-fold: true code-tools: true html-math-method: katex toc: true toc-depth: 3 fig-width: 13 fig-height: 10 toc-title: "Contents" number-sections: true self-contained: true self-contained-math: true smooth-scroll: true fontsize: 0.8em title-block-banner: true citation-location: margineditor: visual---```{r setup}#| echo: false#| message: false#| warning: false#| include: false#load libraries (more than I need but nice ot have)library(tidyverse)library(knitr)library(table1) #Create HTML Tables of Descriptive Statistics https://cran.r-project.org/web/packages/table1/vignettes/table1-examples.html#library(OMTM1) #https://github.com/schildjs/OMTM1/library(Hmisc)library(viridis) #colorslibrary(tidyverse)library(readxl)library(corrplot)library(arsenal)library(GGally)library(ggthemes)library(ggfortify)library(plotly)library(dplyr)library(tidyr)library(cowplot) #allows me to use plotgridtheme_set(ggthemes::theme_calc())scale_color_discrete =scale_color_calc()setwd("/Users/lisalevoir/BIOS7351_Collab/github/BIOS_Collaboration") #this line used to work until I moved this qmd file to my github folder (I need to run this in the console when I switch projects)knitr::opts_knit$set(root.dir ="/Users/lisalevoir/BIOS7351_Collab/github/BIOS_Collaboration/case1") #this is a global option for knittingdt <- readxl::read_xlsx("~/BIOS7351_Collab/github/BIOS_Collaboration/case1/Case1.xlsx")```# Analyzing medical students scoresBackground given in the case description: "The course lasts twelve weeks. Throughout the course, students are assessed in multiple ways, including weekly quizzes, slide exams, and essays. They also take an end of course exam that includes essay, short answer, and multiple-choice components. The final data has the average scores for those assessments. Students are required to take laboratory practical (gross anatomy, histology, pathology and neuroanatomy) exams which are averaged into the final grade. Students also take a National Board of Medical Examiners (NBME) standardized exam in each course. Theoretically, if they do well on these exams, they should do well in the course overall. All of the assessments have been calculated on a 100- point scale."## Questions from Learning Objective 4- How should we define not pass/ marginal pass/ pass thresholds and criteria?- How do these thresholds compare to final exam scores?## DataThere are `r length(unique(dt$id))` students. `r sum(dt$final <= 70)` students scored below 70 on the final exam which is grounds for an immediate failing threshold. `r sum(dt$final <= 80) - sum(dt$final <=70)` students scored between a 70 & 80 on the final which could be considered students for further scrutiny.```{r}label(dt$quiz) <-"Quiz score (mean weekly performance)"label(dt$nbme) <-"National Board of Medical Examiners score"label(dt$ga) <-"Gross anatomy (mean score)"label(dt$slide) <-"Slide exams score (mean)"label(dt$part.c) <-"Part C score"label(dt$essay) <-"Essay score (mean)"label(dt$eob.exam) <-"End of Block (course term) exam"label(dt$final) <-"Final score"table1(~quiz + nbme + ga + slide + part.c + essay+ eob.exam + final , data=dt, topclass="Rtable1-zebra",)length(unique(dt$id))```Note: Part C score is "like a catch-all exam if the knowledge can't be obtained through their lab and essay assessments."- not included in our data (but included in the student evaluation) is the score for the laboratory practical which "has multiple assessment scores which are captured in the data such as the histology, pathology, etc. - which are not specifically named like that." - We will disregard for our purposes### Scores based on startifying by passing the final exam at 70% threshold```{r}dt = dt %>%mutate(quiz =100*quiz)tableby(pass~.,dt %>%select(-id) %>%mutate(pass = final>70),control =tableby.control(numeric.stats =c("meansd","median","range"), )) %>%summary() %>% knitr::kable()```Below is a pairs plot where students are divided into groups depending on whether they passed or if they scored below 80% which we called "almost fail". These students deserve more scrutiny - how did they perform on other assessments?```{r}#| fig-width: 10#| fig-height: 10set.seed(123123)pc =prcomp(dt %>%select(-id,-final) %>%mutate_all(scale))ggpairs(dt %>%select(-id),aes(color=ifelse(final>80,"pass","(almost)fail")),progress = F)``````{r}cl =kmeans(dt %>%select(-id) %>%mutate_all(scale),centers =4)$clusterdt %>%left_join(tibble(id = dt$id,cluster =as.factor(cl))) %>%cbind(pc$x) %>%ggplot(aes(x=PC1,y=final,color=cluster)) +scale_color_calc()+geom_jitter()autoplot(pc,color =as.factor(cl))```## Can I create a better metric?```{r}#| fig-width: 10#| fig-height: 10overall =0.6*rowMeans(dt %>%select(-id,-final,-nbme)) +0.4*dt$nbmedt %>%select(-id) %>%mutate(overall = overall) %>%ggpairs(.,aes(color =ifelse( overall>quantile(overall,0.05),"pass","fail")),progress = F)dt %>%mutate(overall = overall,pass = overall>quantile(overall,0.05)) %>%cbind(pc$x) %>%ggplot(aes(y=PC2,x=PC1,color=pass))+geom_jitter()``````{r}#| fig-width: 10#| fig-height: 10overall =scale(pc$x)[,1:2] %*%c(-0.8,0.2) dt %>%select(-id) %>%mutate(overall =as.numeric(overall)) %>%ggpairs(.,aes(color =ifelse( overall>quantile(overall,0.05),"pass","fail")),progress = F)dt %>%mutate(overall = overall,pass = overall>quantile(overall,0.05)) %>%cbind(pc$x) %>%ggplot(aes(x=PC1,y=PC2,color=pass))+geom_jitter()```
